package DCMARCH::Util;

use strict;

use Cwd qw(abs_path getcwd);
use Exporter qw(import);
use File::Spec qw(tmpdir);
use File::Temp qw(tempdir);
use IO::File;

our @EXPORT = qw(Run expandTar isTarchive isTar Meta trimwhitespace);

$DCMARCH::Util::Verbose = 0;
$DCMARCH::Util::Debug   = 0;
$DCMARCH::Util::Execute = 1;

sub Run {
    my(@cmd) = @_;

    print "@cmd\n" if ($DCMARCH::Util::Verbose);
    
    my $exit = 0;
    
    if ($DCMARCH::Util::Execute) {
        $exit = system(@cmd);
	warn "@cmd failed: $?\n" if ($exit && $DCMARCH::Util::Verbose);
    }

    return $exit;
}

sub expandTar {
    my $tar = shift;
    my $pwd = getcwd;

    # Make sure we have the full path as we may be chdir-ing soon
    $tar = abs_path($tar);

    # If we were given a directory (which shouldn't really happen),
    # just return it and hope for the best
    return $tar if (-d $tar);

    # Locate the system temp dir and create a temp dir for this tarchive
    my $tmp = File::Spec->tmpdir();
    my $tempdir = tempdir("${tmp}/dicom-archive-util_XXXX", CLEANUP => 1);
    chdir $tempdir;

    my $dcmdir;

    my $taropt = 'x';
    $taropt .= 'z' if ($tar =~ /\.gz$/);
    $taropt .= 'j' if ($tar =~ /\.bz2$/);
    $taropt .= 'v' if $DCMARCH::Util::Debug;
    $taropt .= 'f';

    if (&isTarchive($tar)) {
	# We have an actual dicom-archive, so extract the inner tar
	# and return its contents
	&Run('tar', $taropt, $tar) && die;

	my @innertars = glob('*.tar.gz');

	die "Found none or more than one inner tar, I am confused\n" 
	    if (@innertars != 1);

	my $innertar = shift @innertars;
	
	&Run('tar', ($DCMARCH::Util::Debug) ? 'zxvf' : 'zxf', $innertar);

	$dcmdir = "${tempdir}/$innertar";
	$dcmdir =~ s/\.tar.gz//;
    }
    elsif (&isTar($tar)) {
	&Run('tar', $taropt, $tar) && die;

	# We have some kind of 'normal' tarfile, so extract it, and if
	# it looks like it contains some dicom data return its dir
	my @extracted = glob('*');

	if ((@extracted == 1) && (-d $extracted[0])) {
	    # If the tar only has a single directory, assume it is a regular
	    # tar with dicom data
	    $dcmdir = $extracted[0];
	}
	elsif ((@extracted > 5) && &IsDicom(@extracted[1..5])) {
	    # If the tar contained more than 5 items all of which are
	    # DICOM files, assume this is a collection of dicom files
	    $dcmdir = $tempdir;
	}
    }
    else {
	die "$tar is not a tar file or does not contain data in a structure that I recognize\n";
    }
	
    chdir $pwd;

    print "expandTar: returning ($tempdir, $dcmdir)\n" if $DCMARCH::Util::Debug;

    return (abs_path($tempdir), abs_path($dcmdir));
}

sub isDicom {
    foreach my $file (@_) {
	return 0 if (! -f $file);

	my $dicom = DICOM->new();
        $dicom->fill($file);
        my $studyUID = $dicom->value('0020','000D');

        if($studyUID eq "") {
            return 0;
        }
    }

    return 1;
}

sub isTarchive {
    foreach my $file (@_) {
	# It better be a file
	return 0 if (! -f $file);

	my $taropt = 'tf';
	if ($file =~ /\.gz$/) {
	    $taropt = "z${taropt}";
	}
	elsif ($file =~ /\.bz2$/) {
	    $taropt = "j${taropt}";
	}

	# Check the contents of the tarchive, which needs to contain
	# at least a .meta and an inner tar.
	my $contents = `tar $taropt $file 2>&1`;

	return 0 if ($contents !~ /\.meta\n/) || ($contents !~ /\.tar.gz\n/);
    }

    return 1;
}

sub isTar {
    foreach my $file (@_) {
	# It better be a file
	return 0 if (! -f $file);

	my $taropt = 'tf';
	if ($file =~ /\.gz$/) {
	    $taropt = "z${taropt}";
	}
	elsif ($file =~ /\.bz2$/) {
	    $taropt = "j${taropt}";
	}

	# See if we can list the contents. We just want to now whether
	# or not it is a tarball, so suppress tar's error messages
	return 0 if system("tar $taropt $file 2>/dev/null 1>/dev/null");
    }

    return 1;
}

sub Meta {
    my ($file, $metahashref) = @_;

    return 0 if (! &isTarchive($file));

    my $tmp     = File::Spec->tmpdir();
    my $tempdir = tempdir("${tmp}/dicom-archive-util_XXXX", CLEANUP => 1);

    # Extract only the meta file
    &Run('tar', '--wildcards', '-C', $tempdir, '-xf', $file, '*.meta') && die;

    my $metafile = (glob("$tempdir/*.meta"))[0];

    if ((! defined $metafile) || (! -f $metafile)) {
	warn "Unable to extract meta file from $file\n";
	return 0;
    }

    my $metavar;
    my %meta;

    # Open and parse the meta file
    my $metafh = new IO::File $metafile;

    if (! defined $metafh) {
	warn "Unable to open meta file $metafile\n";
	return 0;
    }
    
    my @keys;
  LINE:
    while (<$metafh>) {
	my $line = $_;

	$metavar .= $line;

	if ($line =~ /<\/(.+)>/) {
	    if ($keys[0] ne $1) {
		warn "Error parsing $metafile : end of key $1 with is not the running key $keys[0]\n";
		return 0;
	    }
	    shift @keys;
	    next LINE;
	}
	elsif ($line =~ /<(.+)>/) {
	    unshift(@keys, $1);
	    next LINE;
	}

	if (($keys[0] =~ /STUDY_INFO/) || ($keys[0] =~ /SUMMARY/)) {
	    my ($var, $value);

	    if (&parse_colon_line($line, \$var, \$value)) {
		$meta{$keys[0]}{$var} = $value;
	    }

	    print "$keys[0] $var : $value\n" if $DCMARCH::Util::Debug;
	}
	elsif (($keys[0] =~ /FILES/) || ($keys[0] =~ /ACQUISITIONS/)) {
	    my @vars;

	    &parse_table($line, \@vars);

	    if (defined $meta{$keys[0]}) {
		push(@{ $meta{$keys[0]} }, \@vars);
	    }
	    else {
		$meta{$keys[0]} = [ \@vars ];
	    }

	    print "$keys[0] @vars\n" if $DCMARCH::Util::Debug;
	}
	
    }
    
    undef $metafh;

    %$metahashref = %meta if (defined $metahashref);

    return $metavar;
}
    
sub parse_colon_line {
    my ($line, $varref, $valref) = @_;

    if ($line =~ /^(\*\s)?(.+)\s:\s(.*)$/) {
	$$varref = &compact($2);
	$$valref = &trimwhitespace($3);

	return 1;
    }

    return 0;
}

sub parse_table {
    my ($line, $valsref) = @_;

    @$valsref = split(/\|/, $line);

    foreach my $var (@$valsref) {
	$var = &trimwhitespace($var);
    }
    
    return 1;
}

sub compact {
    my $string = shift;
    
    $string = &trimwhitespace($string);
    $string =~ s/\s/_/g;

    return $string;
} 

sub trimwhitespace {
    my $string = shift;
    $string =~ s/^\s+//;
    $string =~ s/\s+$//;
    return $string;
}

sub read_file {
    my $file = shift;
    my $content;
    open CONTENT, "$file" || die "Could not open file $file\n";
    while ( <CONTENT> ) {
	$content = $content . $_;
    }
    close CONTENT;
    return $content;
}
